home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / tu32.zip / TU32DEMO / BTCHDEMO / BTHMAIN2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-21  |  17KB  |  535 lines
  1. unit Bthmain2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, TU,
  8.   ExtCtrls, DB, DBTables,
  9.   StatDlg, Errtbdlg, DBIErrs;
  10.  
  11. type
  12.   TFormBatchAliasMain = class(TForm)
  13.     TUtilityVerReb: TTUtility;
  14.     Panel1: TPanel;
  15.     ButtonFixAll: TButton;
  16.     ListBoxStatus: TListBox;
  17.     ButtonVerifyOnly: TButton;
  18.     ButtonViewErrTable: TButton;
  19.     ButtonSaveLog: TButton;
  20.     ButtonClose: TButton;
  21.     SaveDialogActivityLog: TSaveDialog;
  22.     TUtilityVerOnly: TTUtility;
  23.     ComboBoxTblAlias: TComboBox;
  24.     EditFilePattern: TEdit;
  25.     ListBoxTables: TListBox;
  26.     RadioGroupRebuildOptions: TRadioGroup;
  27.     Label1: TLabel;
  28.     Label2: TLabel;
  29.     Label3: TLabel;
  30.     Label4: TLabel;
  31.     ComboBoxBorrowAlias: TComboBox;
  32.     Label5: TLabel;
  33.     ListBoxMissing: TListBox;
  34.     Button1: TButton;
  35.     Label6: TLabel;
  36.     Table1: TTable;
  37.     Button2: TButton;
  38.     procedure ButtonFixAllClick(Sender: TObject);
  39.     procedure TUtilityVerRebInfoRebuild(Sender: TObject;
  40.       RebuildCBRec: TRebuildCBData);
  41.     procedure TUtilityVerRebInfoVerify(Sender: TObject;
  42.       VerifyCBRec: TVerifyCBData);
  43.     procedure TUtilityRestInfoVerReb(Sender: TObject; AMessage: String;
  44.       Process: TUVerRebProcess; var Abort: Boolean);
  45.     procedure ButtonCloseClick(Sender: TObject);
  46.     procedure ButtonVerifyOnlyClick(Sender: TObject);
  47.     procedure ButtonSaveLogClick(Sender: TObject);
  48.     procedure ButtonViewErrTableClick(Sender: TObject);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure ComboBoxTblAliasChange(Sender: TObject);
  51.     procedure EditFilePatternChange(Sender: TObject);
  52.     procedure ComboBoxBorrowAliasChange(Sender: TObject);
  53.     procedure Button1Click(Sender: TObject);
  54.     procedure Button2Click(Sender: TObject);
  55.   private
  56.     { Private declarations }
  57.     CurProcess : TUVerRebProcess; {keep track of the rebuild or verify to eliminate screen flash}
  58.     TablesProcessed : Word;
  59.     NotList : Boolean;
  60.     AliasPath,
  61.     AltPath : String[128];
  62.     procedure ZeroGages;
  63.     procedure AssignBatchRec(TU : TTUtility; sList : TStrings; I : Word);
  64.     procedure SendToLog(aMsg : String);
  65.     procedure UpdateStats(TU : TTUtility; BatchList : TStrings);
  66.     procedure DeleteErrorTable;
  67.     function GetAliasPath(TheAlias : String) : String;
  68.     procedure ReDoBorrowList(aNotList : Boolean);
  69.   public
  70.     { Public declarations }
  71.   end;
  72.  
  73. var
  74.   FormBatchAliasMain: TFormBatchAliasMain;
  75.  
  76. implementation
  77.  
  78. {$R *.DFM}
  79.  
  80. Procedure TFormBatchAliasMain.ZeroGages;
  81. begin
  82.   FormStatus.GaugeHeader.Progress := 0;
  83.   FormStatus.GaugeIndex.Progress := 0;
  84.   FormStatus.GaugeData.Progress := 0;
  85.   FormStatus.GaugeHeaderIdx.Progress := 0;
  86.   FormStatus.GaugeIndexIdx.Progress := 0;
  87.   FormStatus.GaugeDataIdx.Progress := 0;
  88.   FormStatus.GaugeIntegrity.Progress := 0;
  89.   FormStatus.GaugeRebuild.Progress := 0;
  90.   FormStatus.LabelNumPacked.Caption := '';
  91.   FormStatus.LabelNumPacked.refresh;
  92. end;
  93.  
  94. Procedure TFormBatchAliasMain.AssignBatchRec(TU : TTUtility;
  95.                                              sList : TStrings;
  96.                                              I : Word);
  97. begin
  98.   TU.TableName := '';
  99.   TU.tBkUpTableName := '';
  100.   TU.TableName      := AliasPath + '\' + sList.Strings[I];
  101.   if fileexists(AltPath + '\' + sList.Strings[I]) then
  102.   begin
  103.     TU.AltStructAlways := True;
  104.     TU.AltStructName  := AltPath + '\' + sList.Strings[I];
  105.   end
  106.   else
  107.   begin
  108.     TU.AltStructAlways := False;
  109.     TU.AltStructName := '';
  110.   end;
  111. end;
  112.  
  113. Procedure TFormBatchAliasMain.SendToLog(aMsg : String);
  114. begin
  115.   With ListBoxStatus do
  116.   begin
  117.     Items.Add(AMsg);
  118.     { This next bit scrolls the text so the most recent msg is visible}
  119.     if (ItemHeight * Items.count) > Height then
  120.       TopIndex:= Items.count - (Height div ItemHeight) ;
  121.   end;
  122.   ListBoxStatus.Refresh;
  123. end;
  124.  
  125.  
  126. Procedure TFormBatchAliasMain.UpdateStats(TU : TTUtility; BatchList : TStrings);
  127. Begin
  128.   with FormStatus do
  129.   begin
  130.     LabelStatus.Caption := '';
  131.     LabelNumRecs.Caption         := InttoStr(TU.TblInfo.iRecords);
  132.     LabelRecSize.Caption         := IntToStr(TU.TblInfo.iRecSize);
  133.     LabelNumFields.Caption       := IntToStr(TU.TblInfo.iFields);
  134.     LabelNumAuxPasswords.Caption := IntToStr(TU.TblInfo.iPasswords);
  135.     if TU.TblInfo.bProtected then
  136.       LabelPasswordTF.Caption := 'True'
  137.     else
  138.       LabelPasswordTF.Caption := 'False';
  139.     Inc(TablesProcessed);
  140.     LabelTableOf.Caption := IntToStr(TablesProcessed);
  141.  
  142.     LabelOfTable.Caption := IntToStr(BatchList.Count);
  143.  
  144.     GroupBoxTableStats.Refresh;
  145.   end;
  146. end;
  147.  
  148. procedure TFormBatchAliasMain.DeleteErrorTable;
  149. Var
  150.   ErrTblName : String[255];
  151. begin
  152.   { make sure the error table is not active }
  153.   BtnBottomDlg.TableErrTable.Active := False;
  154.   BtnBottomDlg.TableErrTable.DatabaseName := Session.PrivateDir;
  155.   {Make sure the error table name has an extension }
  156.   if extractFileExt(BtnBottomDlg.TableErrTable.TableName) = '' then
  157.     ErrTblName := BtnBottomDlg.TableErrTable.TableName + '.DB'
  158.   else
  159.     ErrTblName := BtnBottomDlg.TableErrTable.TableName;
  160.   {if the error table  does not have a path then assign the private one}
  161.   if extractFilePath(BtnBottomDlg.TableErrTable.TableName) = '' then
  162.     ErrTblName := Session.PrivateDir + '\' + ErrTblName;
  163.   {Now delete the table if it exists}
  164.   if fileexists(ErrTblName) then
  165.     BtnBottomDlg.TableErrTable.DeleteTable;
  166. end;
  167.  
  168. procedure TFormBatchAliasMain.ButtonFixAllClick(Sender: TObject);
  169. var
  170.   P1,P2 : TPoint;
  171.   I : Word;
  172.   ProcessList : TListBox;
  173.  
  174. begin
  175.  If (RadioGroupRebuildOptions.ItemIndex = 1) and
  176.     (ComboBoxBorrowAlias.ItemIndex = -1) then
  177.  begin
  178.    Application.MessageBox('You must select an Database Alias to borrow the structure from.',
  179.               '"Always Borrow Structure" Checked',
  180.                MB_ICONHAND OR MB_OK);
  181.    ComboBoxBorrowAlias.SetFocus;
  182.    exit;
  183.  end;
  184.  
  185.  
  186.   ListBoxStatus.Setfocus;
  187.   CurProcess := TURebuilding;
  188.   P1.X := 5;
  189.   P1.Y := 5;
  190.   P2 := ClienttoScreen(P1);
  191.   FormStatus.Left := P2.X;
  192.   FormStatus.Top := P2.Y;
  193.   FormStatus.Show;
  194.   Try
  195.     ZeroGages;
  196.     TablesProcessed := 0;
  197.     If (RadioGroupRebuildOptions.ItemIndex = 1) then
  198.     begin {only do the tables in the AND List}
  199.       ProcessList := ListBoxMissing;
  200.       {make sure it is the AND list}
  201.       ReDoBorrowList(False);
  202. {      TUtilityVerReb.AltStructAlways := True; }
  203.     end
  204.     else
  205.     begin
  206.       ProcessList := ListBoxTables;
  207. {      TUtilityVerReb.AltStructAlways := False; }
  208.     end;
  209.  
  210.     If ProcessList.Items.Count <= 0 then
  211.     begin
  212.       MessageDlg('No qualified tables in the batch to process.',
  213.                  mtWarning, [mbOK], 0);
  214.       exit;
  215.     end;
  216.  
  217.     For I := 0 to ProcessList.Items.Count-1 do
  218.     begin
  219.       try
  220.         ProcessList.ItemIndex := I;
  221.         AssignBatchRec(TUtilityVerReb, ProcessList.Items, I);
  222.         UpdateStats(TUtilityVerReb, ProcessList.Items);
  223.         TUtilityVerReb.ExecuteVerifyRebuild;
  224.  
  225.       except
  226.         {report the error to the log  so it doesn't stop the process}
  227.         on E:Exception do
  228.           SendToLog(E.Message);
  229.       end;
  230.       try
  231.         ZeroGages;
  232.       except
  233.       { report the error to the log  so it doesn't stop the process}
  234.         on E:Exception do
  235.           SendToLog(E.Message);
  236.       end;
  237.     end;
  238.   finally
  239.     sysutils.deletefile(TUtilityVerReb.tErrTableName);
  240.     FormStatus.Hide;
  241.     FormStatus.Refresh;
  242.   end;
  243. end;
  244.  
  245. procedure TFormBatchAliasMain.TUtilityVerRebInfoRebuild(Sender: TObject;
  246.   RebuildCBRec: TRebuildCBData);
  247. begin
  248. { NOTE : This is VERRRRY important. DO NOT MAKE ANY DATABASE CALLS FROM
  249.   THIS METHOD. This event is actually part of a BDE Callback response.
  250.   The rules for Callback responses are clear. The BDE is not re-entrant,
  251.   that means that you can not do anything here that would call the BDE.
  252.   So.... No database calls. Just make pictures.}
  253.   with RebuildCBRec do
  254.   begin
  255.     if sMsg = '' then
  256.     begin
  257.       FormStatus.GaugeRebuild.Progress := iPercentDone;
  258.     end
  259.     else
  260.     begin
  261.       FormStatus.LabelNumPacked.Caption := sMsg;
  262.       FormStatus.LabelNumPacked.refresh;
  263.     end;
  264.   end;
  265. end;
  266.  
  267. procedure TFormBatchAliasMain.TUtilityVerRebInfoVerify(Sender: TObject;
  268.   VerifyCBRec: TVerifyCBData);
  269. begin
  270. { NOTE : This is VERRRRY important. DO NOT MAKE ANY DATABASE CALLS FROM
  271.   THIS METHOD. This event is actually part of a BDE Callback response.
  272.   The rules for Callback responses are clear. The BDE is not re-entrant,
  273.   that means that you can not do anything here that would call the BDE.
  274.   So.... No database calls. Just make pictures.}
  275.   with VerifyCBRec do
  276.   begin
  277.     Case Process of
  278.       TUVerifyTableName :
  279.         begin
  280.           FormStatus.LabelStatus.Caption := TableName;
  281.           FormStatus.LabelStatus.refresh;
  282. {          FormStatus.GroupBoxVerify.refresh; }
  283.         end;
  284.       TUVerifyHeader    : FormStatus.GaugeHeader.Progress := PercentDone;
  285.       TUVerifyIndex     : FormStatus.GaugeIndex.Progress := PercentDone;
  286.       TUVerifyData      : FormStatus.GaugeData.Progress := PercentDone;
  287.       TUVerifySXHeader  : FormStatus.GaugeHeaderIdx.Progress := PercentDone;
  288.       TUVerifySXIndex   : FormStatus.GaugeIndexIdx.Progress := PercentDone;
  289.       TUVerifySXData    : FormStatus.GaugeDataIdx.Progress := PercentDone;
  290.       TUVerifySXIntegrity :   {the index count and current index is passed by the TUVerifySXIntegrity Process}
  291.         begin
  292.           FormStatus.GaugeIntegrity.Progress := PercentDone;
  293.           FormStatus.LabelZeroOf.Caption := IntToStr(CurrentIndex);
  294.           FormStatus.LabelOfZero.Caption := IntToStr(TotalIndex);
  295.           FormStatus.LabelZeroOf.refresh;
  296.           FormStatus.LabelOfZero.refresh;
  297.         end;
  298.     end; {Case}
  299.   end;
  300. end;
  301.  
  302. procedure TFormBatchAliasMain.TUtilityRestInfoVerReb(Sender: TObject;
  303.   AMessage: String; Process: TUVerRebProcess; var Abort: Boolean);
  304. begin
  305.   SendToLog(AMessage);
  306.   { use process to highlight the active panal in the status dialog }
  307.   if process <> CurProcess then
  308.   begin
  309.     Case Process of
  310.     TUVerifying  :
  311.       begin
  312.         FormStatus.GroupBoxVerify.Font.Color := clRed;
  313.         FormStatus.GroupBoxRebuild.Font.Color := clBlack;
  314.       end;
  315.     TURebuilding :
  316.       begin
  317.         FormStatus.GroupBoxVerify.Font.Color := clBlack;
  318.         FormStatus.GroupBoxRebuild.Font.Color := clRed;
  319.       end;
  320.     end; {case}
  321.     FormStatus.GroupBoxVerify.refresh;
  322.     FormStatus.GroupBoxRebuild.refresh;
  323.     CurProcess := Process;
  324.   end;
  325. end;
  326.  
  327. procedure TFormBatchAliasMain.ButtonCloseClick(Sender: TObject);
  328. begin
  329.   DeleteErrorTable;
  330.   Close;
  331. end;
  332.  
  333. procedure TFormBatchAliasMain.ButtonVerifyOnlyClick(Sender: TObject);
  334. { There is nothing really special about the ExecuteVerifyRebuild
  335.   method. It just combines the ExecuteVerify and ExecuteRebuild
  336.   into one convient call. The following shows how to just verify all
  337.   the files in the batch}
  338. var
  339.   P1,P2 : TPoint;
  340.   I : Word;
  341.   ProcessList : TListBox;
  342. begin
  343.   ListBoxStatus.Setfocus;
  344.   CurProcess := TURebuilding;
  345.   P1.X := 5;
  346.   P1.Y := 5;
  347.   P2 := ClienttoScreen(P1);
  348.   FormStatus.Left := P2.X;
  349.   FormStatus.Top := P2.Y;
  350.   FormStatus.GroupBoxVerify.Font.Color := clRed;
  351.   TablesProcessed := 0;
  352.   FormStatus.Show;
  353.   FormStatus.Refresh;
  354.   Try
  355.     ZeroGages;
  356.     SendToLog('STARTING VERIFY ONLY PROCESSING OF THE BATCH');
  357.     TUtilityVerOnly.Options := [];
  358.     If (RadioGroupRebuildOptions.ItemIndex = 1) and
  359.        (ComboBoxBorrowAlias.ItemIndex >= 0) then
  360.     begin     {only do the tables in the AND List}
  361.       ProcessList := ListBoxMissing;
  362.       {make sure it is the AND list}
  363.       ReDoBorrowList(False);
  364.     end
  365.     else
  366.       ProcessList := ListBoxTables;
  367.     If ProcessList.Items.Count <= 0 then
  368.     begin
  369.       MessageDlg('No qualified tables in the batch to process.',
  370.                  mtWarning, [mbOK], 0);
  371.       exit;
  372.     end;
  373.     For I := 0 to ProcessList.Items.Count-1 do
  374.     begin
  375.       try
  376.         ProcessList.ItemIndex := I;
  377.         SendToLog('Verifying Table           :' + ProcessList.Items.Strings[I]);
  378.         AssignBatchRec(TUtilityVerOnly, ProcessList.Items, I);
  379.         UpdateStats(TUtilityVerOnly, ProcessList.Items);
  380.         TUtilityVerOnly.ExecuteVerify;
  381.         SendToLog('Verifying Status          : ' +
  382.            IntToStr(TUtilityVerOnly.iErrorLevel));
  383.       except
  384.         {report the error to the log  so it doesn't stop the process}
  385.         on E:Exception do
  386.           SendToLog(E.Message);
  387.       end;
  388.       try
  389.         ZeroGages;
  390.         {now append all errors to the verify only error toble for reporting}
  391.         if fileexists(TUtilityVerOnly.tErrTableName) then
  392.           TUtilityVerOnly.Options := [vTU_Append_Errors];
  393.       except
  394.         {report the error to the log  so it doesn't stop the process}
  395.         on E:Exception do
  396.           SendToLog(E.Message);
  397.       end;
  398.     end;
  399.     ProcessList.ItemIndex := -1;
  400.   finally
  401.     SendToLog('VERIFY ONLY PROCESSING - COMPLETE');
  402.     FormStatus.Hide;
  403.     FormStatus.GroupBoxRebuild.Font.Color := clBlack;
  404.     FormStatus.Refresh;
  405.   end;
  406.  
  407. end;
  408.  
  409. procedure TFormBatchAliasMain.ButtonSaveLogClick(Sender: TObject);
  410. begin
  411.    if SaveDialogActivityLog.Execute then
  412.    begin
  413.      ListBoxStatus.Items.SaveToFile(SaveDialogActivityLog.FileName);
  414.      if MessageDlg('Do you want to clear the message log?', mtConfirmation,
  415.         [mbYes, mbNo], 0) = mrYes then
  416.         ListBoxStatus.Items.Clear;
  417.    end;
  418. end;
  419.  
  420. procedure TFormBatchAliasMain.ButtonViewErrTableClick(Sender: TObject);
  421. begin
  422.   BtnBottomDlg.TableErrTable.DatabaseName := Session.PrivateDir;
  423.   BtnBottomDlg.TableErrTable.Active := True;
  424.   BtnBottomDlg.ShowModal;
  425.   { Deactivate Error Table }
  426.   BtnBottomDlg.TableErrTable.Active := False;
  427. end;
  428.  
  429. procedure TFormBatchAliasMain.FormCreate(Sender: TObject);
  430. begin
  431.   Session.GetDataBaseNames(ComboBoxTblAlias.Items);
  432.   Session.GetDataBaseNames(ComboBoxBorrowAlias.Items);
  433.   NotList := False;
  434. end;
  435.  
  436. function TFormBatchAliasMain.GetAliasPath(TheAlias : String) : String;
  437. var
  438.   StrList : TStringList;
  439.   I : Word;
  440. begin
  441.   result := '';
  442.   StrList := TStringList.Create;
  443.   Session.GetAliasParams(TheAlias, StrList);
  444.   For I := 0 to StrList.count-1 do
  445.     if pos('PATH=',StrList.Strings[I]) = 1 then
  446.     begin
  447.       result := copy(StrList.Strings[I], 6, 128);
  448.       break;
  449.     end;
  450.  
  451.   StrList.Free;
  452. end;
  453.  
  454. procedure TFormBatchAliasMain.ComboBoxTblAliasChange(Sender: TObject);
  455. begin
  456.   with ComboBoxTblAlias do
  457.   begin
  458.     Session.GetTableNames(Items.Strings[ItemIndex], EditFilePattern.Text ,
  459.                            True, False, ListBoxTables.Items);
  460.     if ItemIndex <> -1 then
  461.       AliasPath := GetAliasPath(Items.Strings[ItemIndex]);
  462.   end;
  463.   If ComboBoxBorrowAlias.ItemIndex <> -1 then  ReDoBorrowList(NotList);
  464. end;
  465.  
  466. procedure TFormBatchAliasMain.EditFilePatternChange(Sender: TObject);
  467. begin
  468.   with ComboBoxTblAlias do
  469.     Session.GetTableNames(Items.Strings[ItemIndex], EditFilePattern.Text ,
  470.                            True, False, ListBoxTables.Items);
  471.   If ComboBoxBorrowAlias.ItemIndex <> -1 then  ReDoBorrowList(NotList);
  472. end;
  473.  
  474. procedure TFormBatchAliasMain.ReDoBorrowList(aNotList : Boolean);
  475. var
  476.   BorrowAliasTbls : TStringList;
  477.   I : Word;
  478. begin
  479.   if ListBoxTables.items.count = 0 then exit;
  480.   NotList := aNotList;
  481.   ListBoxMissing.Clear;
  482.   {Create a place to put the list of tables in the borrow alias}
  483.   BorrowAliasTbls := TStringList.Create;
  484.   with ComboBoxBorrowAlias do
  485.   begin
  486.     {Get the table names in the alias directory and put them in the temp list}
  487.     Session.GetTableNames(Items.Strings[ItemIndex], EditFilePattern.Text,
  488.       True, False, BorrowAliasTbls);
  489.     If NotList then
  490.     begin
  491.       Label5.Caption := 'Files in Batch NOT found in the Borrow Structure DB';
  492.       Label6.Visible := False;
  493.       {Find all the tables in the batch alias directory that are not in the Borrow from
  494.        alias directory}
  495.       For I := 0 to ListBoxTables.Items.Count - 1 do
  496.          if BorrowAliasTbls.IndexOf(ListBoxTables.Items.Strings[I]) = -1 then
  497.            ListBoxMissing.Items.Add(ListBoxTables.Items.Strings[I]);
  498.     end
  499.     else
  500.     begin
  501.       Label5.Caption := 'Files in Batch AND found in the Borrow Structure DB';
  502.       Label6.Visible := True;
  503.       {Find all the tables in the batch alias directory that are not in the Borrow from
  504.        alias directory}
  505.       For I := 0 to ListBoxTables.Items.Count - 1 do
  506.          if BorrowAliasTbls.IndexOf(ListBoxTables.Items.Strings[I]) > -1 then
  507.            ListBoxMissing.Items.Add(ListBoxTables.Items.Strings[I]);
  508.     end;
  509.     {Get the complete path to the Borrow from alias directory}
  510.     AltPath := GetAliasPath(Items.Strings[ItemIndex]);
  511.     BorrowAliasTbls.Free
  512.   end;
  513.  
  514. end;
  515.  
  516. procedure TFormBatchAliasMain.ComboBoxBorrowAliasChange(Sender: TObject);
  517. begin
  518.   if ComboBoxBorrowAlias.ItemIndex <> -1 then
  519.     ReDoBorrowList(NotList);
  520. end;
  521.  
  522. procedure TFormBatchAliasMain.Button1Click(Sender: TObject);
  523. begin
  524.   ReDoBorrowList(not NotList)
  525. end;
  526.  
  527. procedure TFormBatchAliasMain.Button2Click(Sender: TObject);
  528. begin
  529.    tUtilityVerReb.Table := Table1;
  530. end;
  531.  
  532. end.
  533.  
  534.  
  535.